home *** CD-ROM | disk | FTP | other *** search
Text File | 1998-11-15 | 15.6 KB | 334 lines | [TEXT/ScoM] |
- (defun open-gene (l)
- (prog (out a elem)
- loop
- (cond ((null l) (return (reversewoc out))))
- (setq a (explodec (car l)))
- (while (not (null a))
- (setq elem (car a))
- (cond ((equal elem 't)
- (setq elem 'b))
- ((equal elem 'g)
- (setq elem 'd)))
- (setq out (xcons out elem))
- (setq a (cdr a)))
- (setq l (cdr l))
- (go loop)))
-
- ; ----- pepside coding
- ; This set ups symbol correspondeces to certain notes selected
- ; to produce nice chord sequences from the RNA strand. These
- ; tonalities transpose as groups with the control of the the
- ; RNA in a couple of levels, thus adding more interest in the
- ; tonality scheme.
-
- (defun pep-to-chord-1 (pep)
- (cadr (assoc pep '((a (f 4 g# 4 c 5 f 6))
- (b (g 4 c# 5 c# 5 e 5))
- (c (f 4 c# 5 f 4 c# 5))
- (d (c 4 d# 4 d 4 g 4))))))
-
- (defun pep-to-chord-2 (pep)
- (cadr (assoc pep
- '((a (c 4 f 4 g 4 c 4))
- (b (a# 4 a# 4 f 5 c 5))
- (c (c# 5 a# 4 c# 5 g 4))
- (d (g 4 g 4 f# 4 c# 4))))))
-
- (defun pep-to-chord-3 (pep)
- (cadr (assoc pep
- '((a (f 5 g# 5 a# 5 c 6))
- (b (a# 5 a# 5 f 5 c 6))
- (c (g 5 g 6 g 7 g 8))
- (d (g 5 g 5 f# 5 c# 5))))))
-
- (defun pep-to-chord (pep type transp)
- (cond ((equal type '1)
- (transpose-chord (pep-to-chord-1 pep) transp))
- ((equal type '2)
- (transpose-chord (pep-to-chord-2 pep) transp))
- ((equal type '3)
- (transpose-chord (pep-to-chord-3 pep) transp))
- (t (diagnostic (list "illegal type in pep-to-chord" $cr$)))))
-
- (defun pep-to-trans (pep)
- (cadr (assoc pep '((a 0)
- (b -2)
- (c 5)
- (d 7)))))
-
- (defun peps-to-chords (peps type trans-len)
- (prog (out trans-val chord-val count transpeps)
- (cond ((null trans-len) (setq trans-len 4)))
- (setq transpeps peps)
- (setq count trans-len)
- loop
- (cond ((null peps) (return (reversewoc out))))
- (cond ((equal count trans-len)
- (setq trans-val (pep-to-trans (car transpeps)))
- (setq transpeps (cdr transpeps))
- (setq count 1))
- (t (setq count (add1 count))))
- (setq chord-val (pep-to-chord (car peps) type trans-val))
- (setq out (xcons out chord-val))
- (setq peps (cdr peps))
- (go loop)))
-
- ; Here is the HIV (AIDS virus) HXB2 variant RNA code.
-
- (setq pep (open-gene
- '(tggaagggct aattcactcc caacgaagac aagatatcct tgatctgtgg atctaccaca
- cacaaggcta cttccctgat tagcagaact acacaccagg gccagggatc agatatccac
- tgacctttgg atggtgctac aagctagtac cagttgagcc agagaagtta gaagaagcca
- acaaaggaga gaacaccagc ttgttacacc ctgtgagcct gcatggaatg gatgacccgg
- agagagaagt gttagagtgg aggtttgaca gccgcctagc atttcatcac atggcccgag
- agctgcatcc ggagtacttc aagaactgct gacatcgagc ttgctacaag ggactttccg
- ctggggactt tccagggagg cgtggcctgg gcgggactgg ggagtggcga gccctcagat
- cctgcatata agcagctgct ttttgcctgt actgggtctc tctggttaga ccagatctga
- gcctgggagc tctctggcta actagggaac ccactgctta agcctcaata aagcttgcct
- tgagtgcttc aagtagtgtg tgcccgtctg ttgtgtgact ctggtaacta gagatccctc
- agaccctttt agtcagtgtg gaaaatctct agcagtggcg cccgaacagg gacctgaaag
- cgaaagggaa accagagctc tctcgacgca ggactcggct tgctgaagcg cccgcacggc
- aagaggcgag gggcggcgac tggtgagtac gccaaaaatt ttgactagcg gaggctagaa
- ggagagagat gggtgcgaga gcgtcagtat taagcggggg agaattagat cgatgggaaa
- aaattcggtt aaggccaggg ggaaagaaaa aatataaatt aaaacatata gtatgggcaa
- gcagggagct agaacgattc gcagttaatc ctggcctgtt agaaacatca gaaggctgta
- gacaaatact gggacagcta caaccatccc ttcagacagg atcagaagaa cttagatcat
- tatataatac agtagcaacc ctctattgtg tgcatcaaag gatagagata aaagacacca
- aggaagcttt agacaagata gaggaagagc aaaacaaaag taagaaaaaa gcacagcaag
- cagcagctga cacaggacac agcaatcagg tcagccaaaa ttaccctata gtgcagaaca
- tccaggggca aatggtacat caggccatat cacctagaac tttaaatgca tgggtaaaag
- tagtagaaga gaaggctttc agcccagaag tgatacccat gttttcagca ttatcagaag
- gagccacccc acaagattta aacaccatgc taaacacagt ggggggacat caagcagcca
- tgcaaatgtt aaaagagacc atcaatgagg aagctgcaga atgggataga gtgcatccag
- tgcatgcagg gcctattgca ccaggccaga tgagagaacc aaggggaagt gacatagcag
- gaactactag tacccttcag gaacaaatag gatggatgac aaataatcca cctatcccag
- taggagaaat ttataaaaga tggataatcc tgggattaaa taaaatagta agaatgtata
- gccctaccag cattctggac ataagacaag gaccaaagga accctttaga gactatgtag
- accggttcta taaaactcta agagccgagc aagcttcaca ggaggtaaaa aattggatga
- cagaaacctt gttggtccaa aatgcgaacc cagattgtaa gactatttta aaagcattgg
- gaccagcggc tacactagaa gaaatgatga cagcatgtca gggagtagga ggacccggcc
- ataaggcaag agttttggct gaagcaatga gccaagtaac aaattcagct accataatga
- tgcagagagg caattttagg aaccaaagaa agattgttaa gtgtttcaat tgtggcaaag
- aagggcacac agccagaaat tgcagggccc ctaggaaaaa gggctgttgg aaatgtggaa
- aggaaggaca ccaaatgaaa gattgtactg agagacaggc taatttttta gggaagatct
- ggccttccta caagggaagg ccagggaatt ttcttcagag cagaccagag ccaacagccc
- caccagaaga gagcttcagg tctggggtag agacaacaac tccccctcag aagcaggagc
- cgatagacaa ggaactgtat cctttaactt ccctcaggtc actctttggc aacgacccct
- cgtcacaata aagatagggg ggcaactaaa ggaagctcta ttagatacag gagcagatga
- tacagtatta gaagaaatga gtttgccagg aagatggaaa ccaaaaatga tagggggaat
- tggaggtttt atcaaagtaa gacagtatga tcagatactc atagaaatct gtggacataa
- agctataggt acagtattag taggacctac acctgtcaac ataattggaa gaaatctgtt
- gactcagatt ggttgcactt taaattttcc cattagccct attgagactg taccagtaaa
- attaaagcca ggaatggatg gcccaaaagt taaacaatgg ccattgacag aagaaaaaat
- aaaagcatta gtagaaattt gtacagagat ggaaaaggaa gggaaaattt caaaaattgg
- gcctgaaaat ccatacaata ctccagtatt tgccataaag aaaaaagaca gtactaaatg
- gagaaaatta gtagatttca gagaacttaa taagagaact caagacttct gggaagttca
- attaggaata ccacatcccg cagggttaaa aaagaaaaaa tcagtaacag tactggatgt
- gggtgatgca tatttttcag ttcccttaga tgaagacttc aggaagtata ctgcatttac
- catacctagt ataaacaatg agacaccagg gattagatat cagtacaatg tgcttccaca
- gggatggaaa ggatcaccag caatattcca aagtagcatg acaaaaatct tagagccttt
- tagaaaacaa aatccagaca tagttatcta tcaatacatg gatgatttgt atgtaggatc
- tgacttagaa atagggcagc atagaacaaa aatagaggag ctgagacaac atctgttgag
- gtggggactt accacaccag acaaaaaaca tcagaaagaa cctccattcc tttggatggg
- ttatgaactc catcctgata aatggacagt acagcctata gtgctgccag aaaaagacag
- ctggactgtc aatgacatac agaagttagt ggggaaattg aattgggcaa gtcagattta
- cccagggatt aaagtaaggc aattatgtaa actccttaga ggaaccaaag cactaacaga
- agtaatacca ctaacagaag aagcagagct agaactggca gaaaacagag agattctaaa
- agaaccagta catggagtgt attatgaccc atcaaaagac ttaatagcag aaatacagaa
- gcaggggcaa ggccaatgga catatcaaat ttatcaagag ccatttaaaa atctgaaaac
- aggaaaatat gcaagaatga ggggtgccca cactaatgat gtaaaacaat taacagaggc
- agtgcaaaaa ataaccacag aaagcatagt aatatgggga aagactccta aatttaaact
- gcccatacaa aaggaaacat gggaaacatg gtggacagag tattggcaag ccacctggat
- tcctgagtgg gagtttgtta atacccctcc cttagtgaaa ttatggtacc agttagagaa
- agaacccata gtaggagcag aaaccttcta tgtagatggg gcagctaaca gggagactaa
- attaggaaaa gcaggatatg ttactaatag aggaagacaa aaagttgtca ccctaactga
- cacaacaaat cagaagactg agttacaagc aatttatcta gctttgcagg attcgggatt
- agaagtaaac atagtaacag actcacaata tgcattagga atcattcaag cacaaccaga
- tcaaagtgaa tcagagttag tcaatcaaat aatagagcag ttaataaaaa aggaaaaggt
- ctatctggca tgggtaccag cacacaaagg aattggagga aatgaacaag tagataaatt
- agtcagtgct ggaatcagga aagtactatt tttagatgga atagataagg cccaagatga
- acatgagaaa tatcacagta attggagagc aatggctagt gattttaacc tgccacctgt
- agtagcaaaa gaaatagtag ccagctgtga taaatgtcag ctaaaaggag aagccatgca
- tggacaagta gactgtagtc caggaatatg gcaactagat tgtacacatt tagaaggaaa
- agttatcctg gtagcagttc atgtagccag tggatatata gaagcagaag ttattccagc
- agaaacaggg caggaaacag catattttct tttaaaatta gcaggaagat ggccagtaaa
- aacaatacat actgacaatg gcagcaattt caccggtgct acggttaggg ccgcctgttg
- gtgggcggga atcaagcagg aatttggaat tccctacaat ccccaaagtc aaggagtagt
- agaatctatg aataaagaat taaagaaaat tataggacag gtaagagatc aggctgaaca
- tcttaagaca gcagtacaaa tggcagtatt catccacaat tttaaaagaa aaggggggat
- tggggggtac agtgcagggg aaagaatagt agacataata gcaacagaca tacaaactaa
- agaattacaa aaacaaatta caaaaattca aaattttcgg gtttattaca gggacagcag
- aaattcactt tggaaaggac cagcaaagct cctctggaaa ggtgaagggg cagtagtaat
- acaagataat agtgacataa aagtagtgcc aagaagaaaa gcaaagatca ttagggatta
- tggaaaacag atggcaggtg atgattgtgt ggcaagtaga caggatgagg attagaacat
- ggaaaagttt agtaaaacac catatgtatg tttcagggaa agctagggga tggttttata
- gacatcacta tgaaagccct catccaagaa taagttcaga agtacacatc ccactagggg
- atgctagatt ggtaataaca acatattggg gtctgcatac aggagaaaga gactggcatt
- tgggtcaggg agtctccata gaatggagga aaaagagata tagcacacaa gtagaccctg
- aactagcaga ccaactaatt catctgtatt actttgactg tttttcagac tctgctataa
- gaaaggcctt attaggacac atagttagcc ctaggtgtga atatcaagca ggacataaca
- aggtaggatc tctacaatac ttggcactag cagcattaat aacaccaaaa aagataaagc
- cacctttgcc tagtgttacg aaactgacag aggatagatg gaacaagccc cagaagacca
- agggccacag agggagccac acaatgaatg gacactagag cttttagagg agcttaagaa
- tgaagctgtt agacattttc ctaggatttg gctccatggc ttagggcaac atatctatga
- aacttatggg gatacttggg caggagtgga agccataata agaattctgc aacaactgct
- gtttatccat tttcagaatt gggtgtcgac atagcagaat aggcgttact cgacagagga
- gagcaagaaa tggagccagt agatcctaga ctagagccct ggaagcatcc aggaagtcag
- cctaaaactg cttgtaccaa ttgctattgt aaaaagtgtt gctttcattg ccaagtttgt
- ttcataacaa aagccttagg catctcctat ggcaggaaga agcggagaca gcgacgaaga
- gctcatcaga acagtcagac tcatcaagct tctctatcaa agcagtaagt agtacatgta
- acgcaaccta taccaatagt agcaatagta gcattagtag tagcaataat aatagcaata
- gttgtgtggt ccatagtaat catagaatat aggaaaatat taagacaaag aaaaatagac
- aggttaattg atagactaat agaaagagca gaagacagtg gcaatgagag tgaaggagaa
- atatcagcac ttgtggagat gggggtggag atggggcacc atgctccttg ggatgttgat
- gatctgtagt gctacagaaa aattgtgggt cacagtctat tatggggtac ctgtgtggaa
- ggaagcaacc accactctat tttgtgcatc agatgctaaa gcatatgata cagaggtaca
- taatgtttgg gccacacatg cctgtgtacc cacagacccc aacccacaag aagtagtatt
- ggtaaatgtg acagaaaatt ttgacatgtg gaaaaatgac atggtagaac agatgcatga
- ggatataatc agtttatggg atcaaagcct aaagccatgt gtaaaattaa ccccactctg
- tgttagttta aagtgcactg atttgaagaa tgatactaat accaatagta gtagcgggag
- aatgataatg gagaaaggag agataaaaaa ctgctctttc aatatcagca caagcataag
- aggtaaggtg cagaaagaat atgcattttt ttataaactt gatataatac caatagataa
- tgatactacc agctatagct tgacaagttg taacacctca gtcattacac aggcctgtcc
- aaaggtatcc tttgagccaa ttcccataca ttattgtgcc ccggctggtt ttgcgattct
- aaaatgtaat aataagacgt tcaatggaac aggaccatgt acaaatgtca gcacagtaca
- atgtacacat ggaattaggc cagtagtatc aactcaactg ctgttaaatg gcagtctagc
- agaagaagag gtagtaatta gatctgtcaa tttcacggac aatgctaaaa ccataatagt
- acagctgaac acatctgtag aaattaattg tacaagaccc aacaacaata caagaaaaag
- aatccgtatc cagagaggac cagggagagc atttgttaca ataggaaaaa taggaaatat
- gagacaagca cattgtaaca ttagtagagc aaaatggaat aacactttaa aacagataga
- tagcaaatta agagaacaat tcggaaataa taaaacaata atctttaagc aatcctcagg
- aggggaccca gaaattgtaa cgcacagttt taattgtgga ggggaatttt tctactgtaa
- ttcaacacaa ctgtttaata gtacttggtt taatagtact tggagtactg aagggtcaaa
- taacactgaa ggaagtgaca caatcaccct cccatgcaga ataaaacaaa ttataaacat
- gtggcagaaa gtaggaaaag caatgtatgc ccctcccatc agtggacaaa ttagatgttc
- atcaaatatt acagggctgc tattaacaag agatggtggt aatagcaaca atgagtccga
- gatcttcaga cttggaggag gagatatgag ggacaattgg agaagtgaat tatataaata
- taaagtagta aaaattgaac cattaggagt agcacccacc aaggcaaaga gaagagtggt
- gcagagagaa aaaagagcag tgggaatagg agctttgttc cttgggttct tgggagcagc
- aggaagcact atgggcgcag cctcaatgac gctgacggta caggccagac aattattgtc
- tggtatagtg cagcagcaga acaatttgct gagggctatt gaggcgcaac agcatctgtt
- gcaactcaca gtctggggca tcaagcagct ccaagcaaga atcctagctg tggaaagata
- cctaaaggat caacagctcc tagggatttg gggttgctct ggaaaactca tttgcaccac
- tgctgtgcct tggaatgcta gttggagtaa taaatctctg gaacagatct ggaatcacac
- gacctggatg gagtgggaca gagaaattaa caattacaca agcttaatac actccttaat
- tgaagaatcg caaaaccagc aagaaaagaa tgaacaagaa ttattggaat tagataaatg
- ggcaagtttg tggaattggt ttaacataac aaattggctg tggtatataa aattattcat
- aatgatagta ggaggcttgg taggtttaag aatagttttt gctgtacttt ctatagtgaa
- tagagttagg cagggatatt caccattatc gtttcagacc cacctcccaa tcccgagggg
- acccgacagg cccgaaggaa tagaagaaga aggtggagag agagacagag acagatccat
- tcgattagtg aacggatcct tggcacttat ctgggacgat ctgcggagcc tgtgcctctt
- cagctaccac cgcttgagag acttactctt gattgtaacg aggattgtgg aacttctggg
- acgcaggggg tgggaagccc tcaaatattg gtggaatctc ctacagtatt ggagtcagga
- actaaagaat agtgctgtta gcttgctcaa tgccacagcc atagcagtag ctgaggggac
- agatagggtt atagaagtag tacaaggagc ttgtagagct attcgccaca tacctagaag
- aataagacag ggcttggaaa ggattttgct ataagatggg tggcaagtgg tcaaaaagta
- gtgtgattgg atggcttact gtaagggaaa gaatgagacg agctgagcca gcagcagatg
- gggtgggagc agcatctcga gacctggaaa aacatggagc aatcacaagt agcaacacag
- cagctaccaa tgctgcttgt gcctggctag aagcacaaga ggaggaggag gtgggttttc
- cagtcacacc tcaggtacct ttaagaccaa tgacttacaa ggcagctgta gatcttagcc
- actttttaaa agaaaagggg ggactggaag ggctaattca ctcccaaaga agacaagata
- tccttgatct gtggatctac cacacacaag gctacttccc tgattgacag aactacacac
- cagggccagg ggtcagatat ccactgacct ttggatggtg ctacaagcta gtaccagttg
- agccagataa gatagaagag gccaataaag gagagaacac cagcttgtta caccctgtga
- gcctgcatgg gatggatgac ccggagagag aagtgttaga gtggaggttt gacagccgcc
- tagcatttca tcacgtggcc cgagagctgc atccggagta cttcaagaac tgctgacatc
- gagcttgcta caagggactt tccgctgggg actttccagg gaggcgtggc ctgggcggga
- ctggggagtg gcgagccctc agatcctgca tataagcagc tgctttttgc ctgtactggg
- tctctctggt tagaccagat ctgagcctgg gagctctctg gctaactagg gaacccactg
- cttaagcctc aataaagctt gccttgagtg cttcaagtag tgtgtgcccg tctgttgtgt
- gactctggta actagagatc cctcagaccc ttttagtcag tgtggaaaat ctctagca)))
-
- ; Set up default length for all instruments.
-
- (def-length
- default '1/16
- )
-
- ; Melodies all follow the same symbols.
-
- (def-symbol
- default pep
- )
-
- ; Tonality is different for all instruments.
-
- (def-tonality
- inst1 (peps-to-chords pep 1 4)
- inst2 (peps-to-chords pep 2 4)
- inst3 (peps-to-chords pep 3 4)
- )
-
- ; Use some variations in velocities.
-
- (def-velocity
- inst1 '(65 75 85 90 100 40)
- inst2 '(74 84 70 65 60 94 80 70)
- inst3 '(100 90 80 70 60 50)
- )
-
- ; Calculate zones from the total length of RNA.
-
- (setq zones (symbol-trim (truncate (/ (length pep) (* 16 4)))
- '(4/1 4/1 4/1 4/1 4/1 4/1 -4/1 4/1)))
-
- (def-zone
- inst1 zones
- inst2 (symbol-scroll 1 (zone-of inst1))
- inst3 (symbol-scroll 1 (zone-of inst2))
- )
-
- (def-program mu80-sounds
- inst1 ((flute) (flute) (flute) (flute) (bassoon)
- (panflute) (panflute) (panflute) (panflute) (trumpet))
- inst2 warmpad
- inst3 ((nylongtr) (nylongtr) (nylongtr) (nylongtr) (marimba))
- )
-
- ; Play 70 percent of the maximum value with +-10 percent variation range
- ; controlled by Brownian noise.
-
- (def-expression
- default ((legato 70 10 0.4))
- )
-
- (def-controller mu80-controllers
- (inst1 volume (list '(69) '(69) '(69) '(69) '(73)
- '(80) '(80) '(80) '(80) '(73))
- panning (list (vector-round 0 15 (gen-noise-white 10 1 0.51))))
- (inst2 volume (list '(80)'(80) '(100))
- resonance (list '(125))
- filter (list '(125)
- '(125)
- '(125)
- '(122)
- '(125)
- (vector-round 80 127 (gen-sin 1 0.3 64)))
- panning (list (vector-round 44 90 (gen-sin 6 0.3 128))))
- (inst3 volume (list '(59))
- panning (list (vector-round 95 127 (gen-noise-white 10 1.0 0.52))))
- )
-
- ; Compile the MIDI file
-
- (def-channel
- inst1 5
- inst2 6
- inst3 7
- )
-
- (def-tuning
- inst1 (vector-round -300 300 (gen-noise-white 1024 1.0 0.52))
- inst2 (vector-round -300 300 (gen-noise-white 1024 1.0 0.252))
- inst3 (vector-round -300 300 (gen-noise-white 1024 1.0 0.352))
- )
-
- (midiport :printer)
-
- (compile-instrument-p "ccl;output:" "aids rna"
- inst1
- inst2
- inst3
- )
-
-